home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
YOOHOO2U.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
38KB
|
1,247 lines
UNIT YooHoo2U;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ YooHoo/2U2 & EMSI protocol routines Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32;
FUNCTION StartMailSession: Boolean;
PROCEDURE ReceiveMailSession(InByte: Integer);
IMPLEMENTATION
USES OpCrt, OpWindow, OpString, OpDos, OpDate, Dos, ApTimer,
Globals, Com, Crc, Modem, NodeList, MailUtil, WZSend, UnixDate,
ZMisc, ZSend, ZReceive, OproUtil, Display, Util, BiMail, StrUtil,
FileUtil, Protocol, FallBack, Janus, TransVid, LogFile, DosShell, InterCom,
MTask, ParseReq, NetFile, PoPTypes;
CONST
EMSIBufLen = 4096;
TYPE
TEMSIData = RECORD
BaudRate,
Options : S20;
Flags,
ProdSerial,
ProdName,
Location,
Phone : S80;
Tranx : S8;
END;
EMSIBufType=ARRAY[1..EMSIBufLen] OF CHAR;
VAR
AkaNum : ShortInt;
EMSIData : TEMSIData;
FUNCTION NowAsUnixDate: LongInt;
VAR
d,m,y,dow,h,min,s,s100 : Word;
BEGIN
GetDate(y,m,d,dow);
GetTime(h,min,s,s100);
NowAsUnixDate:=GetUnixDate(y,m,d,h,min,s);
END;
PROCEDURE RemoveEmptyDir(CONST Adr: TFidoAddress);
VAR
s : PathStr;
BEGIN
IF NOT Cfg.KeepEmptyDirs THEN
BEGIN
ChangeDir(Cfg.Outbound);
IF Adr.Point<>0 THEN
BEGIN
s:=HoldAreaPath(Adr,False);
RmDir(Copy(s,1,Length(s)-1));
IF IOResult<>0 THEN ;
END;
IF Adr.Zone<>Cfg.Addresses[Cfg.MainAdrNum].Zone THEN
BEGIN
s:=HoldAreaNameMunge(Adr.Zone,False);
RmDir(Copy(s,1,Length(s)-1));
IF IOResult<>0 THEN ;
END;
ChDir(Copy(StartPath, 1, Length(StartPath)-1));
END;
END;
PROCEDURE GetRightAkA(VAR Address: TFidoAddress; VAR AkaNum: ShortInt);
VAR
i : Byte;
Found : Boolean;
BEGIN
Address:=Cfg.Addresses[Cfg.MainAdrNum];
i:=1 ; Found:=False ;
AkaNum:=Cfg.MainAdrNum;
REPEAT
IF (Cfg.Addresses[i].Zone<>0) And (Cfg.Addresses[i].Zone=Call.Zone) AND
(Cfg.Addresses[i].Zone<>Cfg.Addresses[Cfg.MainAdrNum].Zone) THEN
BEGIN
Address:=Cfg.Addresses[i];
AddLog(':','Using AKA: ('+Address2Str(Address)+')');
Found:=True;
AkaNum:=i;
END;
Inc(i);
UNTIL (i>MaxAddresses) OR (Found);
END;
FUNCTION CheckPassword(HaveBoth: Boolean): Boolean;
VAR
Node : TNodeInfo;
f : TNetFile;
BEGIN
CheckPassword:=True;
IF AsciiZ2Str(Hello.Password,8)<>'' THEN
BEGIN
IF HaveBoth And (StUpCase(AsciiZ2Str(Hello.Password,8))<>Trim(StUpCase(AsciiZ2Str(RemHello.Password,8)))) THEN
BEGIN
IF IsCaller THEN
BEGIN
AddLog('!','Password override on outgoing call: (local/remote) "'
+StUpCase(AsciiZ2Str(Hello.Password,8))+'"/"'+Trim(StUpCase(AsciiZ2Str(RemHello.Password,8)))+'"');
END ELSE
BEGIN
AddLog('!', 'Password error: (local/remote) "'+
+StUpCase(AsciiZ2Str(Hello.Password,8))+'"/"'+Trim(StUpCase(AsciiZ2Str(RemHello.Password,8)))+'"');
DropCarrier;
CheckPassword:=False;
END;
END;
END ELSE
IF (HaveBoth) AND (RemHello.PassWord[1]<>#0) THEN
BEGIN
AddLog('#','Remote has password on you: "'+StUpCase(AsciiZ2Str(RemHello.Password,8))+'"');
{ Check på en eller anden liste over adresser der må oprettes }
IF FindNodeInfo(Node, RemHello.Address) THEN
AddLog(':','Updating password for '+Address2Str(RemHello.Address))
ELSE
AddLog(':','Added '+Address2Str(RemHello.Address)+' to nodes');
Node.SessionPwd:=StUpCase(AsciiZ2Str(RemHello.Password,8));
Node.Address:=RemHello.Address;
PutNodeInfo(Node);
{
f.Open(StartPath+PoPNodesFileName, SizeOf(Node), True) ;
f.Seek(f.RecNum+1);
f.Write(Node);
f.Close;
END
}
END;
END;
PROCEDURE FillOutHello;
VAR
ok: Integer;
BEGIN
FillChar(Hello, SizeOf(Hello), 0);
WITH Hello DO
BEGIN
Signal:=$6f;
HelloVersion:=$01;
ProductCode:=PoPProductCode;
Val(Copy(Ver,1,Pos('.',Ver)-1),ProductMaj,ok);
Val(Copy(Ver,Pos('.',Ver)+1,2),ProductMin,ok);
Str2AsciiZ(cfg.system, SystemName, 60);
Str2AsciiZ(cfg.sysop, Sysop, 20);
Address.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
IF (Not IsCaller) Or (NodesRec.UseFake=#0) THEN NodesRec.UseFake:=' ';
IF (Cfg.Addresses[Cfg.MainAdrNum].Point<>0) And
(((Cfg.UseFakeAddress) And (NodesRec.UseFake=' ')) Or
(NodesRec.UseFake='Y')) THEN
BEGIN
Address.Net:=Cfg.Pointnet;
Address.Node:=Cfg.Addresses[Cfg.MainAdrNum].Point;
END ELSE
BEGIN
Address:=Cfg.Addresses[Cfg.MainAdrNum];
GetRightAkA(Address,AkaNum);
END;
IF FoundInNodes AND (NodesRec.SessionPwd<>'') THEN
Str2AsciiZ(NodesRec.SessionPwd, Password, 9)
ELSE
IF FoundInNl THEN Str2AsciiZ(NodelistEntry.Password, Password, 9);
Capabilities:=[ZedZapper, ZedZipper];
IF ((CurrentEvent.typ AND etRequests)=etRequests) AND (ReqOk) AND
NOT (NodesRec.DisallowReq) AND (ComPort^.GetBaudRate>=Cfg.Request.MinBaud) THEN Capabilities:=Capabilities + [WzFreq];
IF FullDuplex THEN
BEGIN
{$IFNDEF OS2}
IF (Cfg.Bimail.BimodemPath<>'') And (NodesRec.UseFullDuplex IN [#0,'Y','B',' ']) THEN
Capabilities:=Capabilities + [CanDoBiMail];
{$ENDIF}
IF ((Cfg.UseJanus) And (NodesRec.UseFullDuplex IN [#0,'Y','J',' '])) Or
(NodesRec.UseFullDuplex IN ['Y','J']) THEN
Capabilities:=Capabilities + [DoesJanus];
END;
END;
END;
PROCEDURE ShowHisData;
VAR
TmpPtr : POutList;
s : String;
i : Byte;
l : LongInt;
d, m, y, h, min, sec : Word;
BEGIN
IF RemHello.ProductCode=PoPProductCode THEN
IntroWin^.wFastWrite('PoP²', 2, 76, Cfg.Color[1].TextColor OR Blink);
GotSomeMail:=False;
GotSomeFiles:=False;
IF Not CmpAdr(Call, RemHello.Address) AND (IsCaller) THEN
BEGIN
AddLog(':','Called '+Address2Str(Call)+' and got '+Address2Str(RemHello.Address));
i:=1;
WHILE (i<=MaxAddresses) AND (RemAka[i].Zone<>0) DO
Inc(i);
IF i<=MaxAddresses THEN RemAka[i]:=RemHello.Address;
END;
IF NOT IsCaller THEN
BEGIN
Call:=RemHello.Address;
RemapAddress(Call);
IF RemHello.SystemName[1]=#0 THEN
IF FoundInNl THEN
BEGIN
Move(NodelistEntry.SystemName[1], RemHello.SystemName, Length(NodelistEntry.SystemName));
Move(NodelistEntry.SysOpName[1], RemHello.SysOp, Length(NodelistEntry.SysOpName));
END ELSE
BEGIN
s:='Unknown';
Move(s[1], RemHello.SystemName, Length(s));
Move(s[1], RemHello.SysOp, Length(s));
END;
SetInterCom(ICConnect,Call,False);
END;
IntroWin^.wFastText(Pad(Copy(Asciiz2Str(RemHello.SystemName, 60),1,45)+' - '+Asciiz2Str(RemHello.sysop,20)+
' ('+Address2Str(RemHello.Address)+')', 79),1,2);
IF IsCaller THEN
AddToCallList(2,RemHello.Address,AsciiZ2Str(RemHello.SystemName,60))
ELSE
AddToCallList(1,RemHello.Address,AsciiZ2Str(RemHello.SystemName,60));
AddLog('*', Asciiz2Str(RemHello.SystemName, 60)+' ('+Address2Str(RemHello.Address)+')');
AddLog('*','Remote uses: ' + ProductNames(RemHello.ProductCode)+' Version '+Long2Str(RemHello.ProductMaj)+'.'+
tochar(RemHello.ProductMin));
AddLog(':', 'SysOp: ' + Asciiz2Str(RemHello.sysop, 20));
IF RemHello.Password[1] <> #0 THEN
AddLog('*', 'Password protected session');
IF RemAka[1].Zone<>0 THEN
BEGIN
s:='Remote AKA''s:';
i:=1;
WHILE (i<=MaxAddresses) AND (RemAka[i].Zone<>0) DO
BEGIN
s:=s+' '+Address2Str(RemAka[i]);
Inc(i);
END;
AddLog(':',s)
END;
IF EMSIData.Phone<>'' THEN AddLog(':','EMSI Phone : '+EMSIData.Phone);
IF EMSIData.Location<>'' THEN AddLog(':','EMSI Location : '+EMSIData.Location);
IF EMSIData.Options<>'' THEN AddLog(':','EMSI Options : '+EMSIData.Options);
IF EMSIData.Flags<>'' THEN AddLog(':','EMSI Flags : '+EMSIData.Flags);
IF EMSIData.BaudRate<>'' THEN AddLog(':','EMSI Baudrate : '+EMSIData.BaudRate);
IF EMSIData.ProdName<>'' THEN AddLog('*','EMSI Product name: '+EMSIData.ProdName);
IF EMSIData.ProdSerial<>'' THEN AddLog('*','EMSI serial no. : '+EMSIData.ProdSerial);
IF EMSIData.Tranx<>'' THEN
BEGIN
IF Str2Long('$'+EMSIData.Tranx, l) THEN
BEGIN
UnpackUnix(l, y, m, d, h, min, sec);
AddLog('*','EMSI Tranx time : '+DMYToDateString('dd nnn yy', d, m, y)+' '+
TimeToTimeString('hh:mm:ss', HMSToTime(h, min, sec)));
IF NodesRec.EMSISetTime THEN SynchTimeDiff:=l-NowAsUnixDate+1;
END;
END;
IF NOT IsCaller THEN
BEGIN
IF (Pos('PUP',EMSIData.Options)>0) or (Pos('NPU',EMSIData.Options)>0) THEN RemAka[1].Zone:=0;
TmpPtr:=POutList(OutList^.Head);
WHILE (TmpPtr<>Nil) And Not CmpAdr(Call, TmpPtr^.Address) DO
TmpPtr:=POutList(OutList^.Next(TmpPtr));
IF TmpPtr<>Nil THEN
BEGIN
CLOutListPtr:=TmpPtr; FLOutListPtr:=TmpPtr;
UpdateOutboundWindow;
END;
IF (CurrentEvent.ConnectTo.Zone<>0) AND
(NOT TimeIsBetween(Cfg.ZMHStart,Cfg.ZMHEnd)) AND
(NOT CmpAdr(CurrentEvent.ConnectTo,RemHello.Address)) THEN
BEGIN
AddLog('!','Only '+Address2Str(CurrentEvent.ConnectTo)+' allowed. Hanging up');
DropCarrier;
END;
IF (GlobNodeStat=nsUnKnown) AND Cfg.Curmudgeon THEN
BEGIN
AddLog('!','Only known system allowed. Hanging up');
DropCarrier;
END;
END;
END;
FUNCTION SendHello : Boolean;
LABEL h2;
VAR
t1,
FailSafe : EventTimer;
InByte : Integer;
Crc16 : Word;
a : Byte;
BEGIN
SendHello:=False;
FillOutHello;
IF Not CheckPassword(Not IsCaller) THEN
BEGIN
DropCarrier;
Exit;
END;
ComPort^.SetXon(off);
ComPort^.SetBreak(Off);
{ IF FCtrlC(0) THEN ;}
NewTimerSecs(FailSafe, 60);
REPEAT
h2:
ComPort^.WriteByte($1f, False);
Crc16:=0;
FOR a:=1 TO 128 DO
BEGIN
ComPort^.WriteByte(HelloByte[a], False);
Crc16:=UpdCrc16(HelloByte[a], Crc16);
END;
IF NOT ComPort^.Carrier THEN Exit;
Crc16:=UpdCrc16(0, Crc16);
Crc16:=UpdCrc16(0, Crc16);
ComPort^.PurgeIn;
ComPort^.WriteByte(Hi(Crc16), False);
ComPort^.WriteByte(Lo(Crc16), True);
NewTimerSecs(t1, 30);
REPEAT
InByte:=TimedRead(1000);
IF InByte<0 THEN
BEGIN
AddLog('!', 'SendHello: TimeOut'); { = timed out }
DropCarrier;
Exit;
END;
CASE InByte OF
Ack: BEGIN
SendHello:=True;
EXIT;
END;
63 : BEGIN
AddLog('!', 'drats');
GOTO h2;
END;
END;
UNTIL TimerExpired(t1);
UNTIL TimerExpired(FailSafe);
END;
FUNCTION GetHello : Boolean;
LABEL r2,r3,r4,r5,r6,r7,r8;
VAR
FailSafe : EventTimer;
InByte : Integer;
a,count,errors : Byte;
CrcIn, Crc16 : Word;
BEGIN
GetHello:=False;
ComPort^.PurgeIn;
ComPort^.PurgeOut;
FillChar(RemHello, SizeOf(RemHello), 0);
ComPort^.SetXon(off);
ComPort^.SetBreak(Off);
{ IF FCtrlC(0) THEN ;}
count:=0;
errors:=0;
NewTimerSecs(FailSafe, 30);
r2:
ComPort^.WriteByte(Enq, True);
r3:
InByte:=TimedRead(100);
IF InByte<0 THEN GOTO r4;
IF NOT ComPort^.Carrier THEN EXIT;
CASE InByte OF
$1f : GOTO r5;
YooHoo : GOTO r2;
ELSE GOTO r3;
END;
r4:
Inc(Count);
IF Count>9 THEN Exit ELSE GOTO r2;
r5:
{ Get hello packet from other end }
Crc16:=0;
FOR a:=1 TO 128 DO
BEGIN
InByte:=TimedRead(1000);
IF (InByte<0) OR (TimerExpired(FailSafe)) THEN Exit;
RemHelloByte[a]:=LO(InByte);
Crc16:=UpdCrc16(RemHelloByte[a], Crc16);
END;
r6:
Crc16:=UpdCrc16(0, Crc16);
Crc16:=UpdCrc16(0, Crc16);
InByte:=TimedRead(1000);
IF NOT ComPort^.Carrier THEN Exit;
IF InByte<0 THEN GOTO r7;
CrcIn:=WORD(LO(InByte) SHL 8);
InByte:=TimedRead(1000);
IF NOT ComPort^.Carrier THEN Exit;
IF InByte<0 THEN GOTO r7;
CrcIn:=CrcIn + LO(InByte);
IF CrcIn=Crc16 THEN GOTO r8 ELSE GOTO r7;
r7:
Inc(Errors);
IF errors>9 THEN EXIT;
ComPort^.WriteByte(Byte('?'), True);
GOTO r3;
r8:
ComPort^.WriteByte(Byte(Ack), False);
ComPort^.WriteByte(Byte(YooHoo), True);
ShowHisData;
GetHello:=ComPort^.Carrier;
END;
FUNCTION WaZoo: Boolean;
LABEL
ItsOverAndOut;
VAR
SaveDir,
ReqFile : PathStr;
SaveWin : Pointer;
i : Byte;
SharedCap : YooHooCapSet;
PROCEDURE TransferNetFiles(Mode: Byte);
LABEL
EndWaZoo;
BEGIN
SetupTransferWindows(False);
fsent:=0;
IF IsCaller THEN
BEGIN
IF (CurrentEvent.typ AND etNosend)=etNoSend THEN
BEGIN
CASE Mode OF
1 : ZModemSend('', '', - 2, 8192);
2 : SendFile('','',SEALink);
3 : SendFile('','',TeLink);
END;
END ELSE
BEGIN
IF NOT SendWaZOO(Mode) THEN GOTO EndWaZoo;
END;
IF NOT ComPort^.Carrier THEN GOTO EndWaZoo;
CASE Mode OF
1 : IF ZModemReceive(cfg.inbound[GlobNodeStat],True)<>ZTRUE THEN GOTO EndWaZoo;
2 : IF ReceiveFile(cfg.inbound[GlobNodeStat],'',SEALink)<>0 THEN GOTO EndWaZoo;
3 : IF ReceiveFile(cfg.inbound[GlobNodeStat],'',TeLink)<>0 THEN GOTO EndWaZoo;
END;
END ELSE
BEGIN
CASE Mode OF
1 : ZModemReceive(cfg.inbound[GlobNodeStat],True);
2 : ReceiveFile(cfg.inbound[GlobNodeStat],'',SEALink);
3 : ReceiveFile(cfg.inbound[GlobNodeStat],'',TeLink);
END;
IF NOT ComPort^.Carrier THEN GOTO EndWaZoo;
IF (CurrentEvent.typ AND etNoSend)=etNoSend THEN
BEGIN
RequestSent:=False;
CASE Mode OF
1 : ZModemSend('', '', - 2, 8192);
2 : SendFile('','',SEALink);
3 : SendFile('','',TeLink);
END;
END ELSE
BEGIN
IF NOT SendWaZOO(Mode) THEN GOTO EndWaZoo;
END;
IF NOT ComPort^.Carrier THEN GOTO EndWaZoo;
IF RequestSent THEN
BEGIN
CASE Mode OF
1 : ZModemReceive(Cfg.Inbound[GlobNodeStat], True);
2 : ReceiveFile(Cfg.Inbound[GlobNodeStat], '', SEALink);
3 : ReceiveFile(Cfg.Inbound[GlobNodeStat], '', TeLink);
END;
END;
END;
EndWaZoo:
RemoveTransferWindows;
END;
BEGIN
IF IsCaller THEN
IF NOT CheckPassword(True) THEN GOTO ItsOverAndOut;
ComPort^.PurgeIn;
FOR i:=1 TO MaxAddresses DO
WITH Cfg.Addresses[i] DO
DeleteFile(MakeReqFileName(Net, Node, GlobNodeStat));
DeleteFile(HoldFileName(Call,False)+'RSP');
IF IsCaller THEN Inc(StatRec^.DayStat[0].CallsGood);
SharedCap:=(Hello.Capabilities * RemHello.Capabilities);
WaZOO:=True;
{---------------------------------------------------------------------}
{ NON STANDARD BiModem mail transfer }
{---------------------------------------------------------------------}
{$IFNDEF OS2}
IF CanDoBiMail IN SharedCap THEN
BEGIN
AddLog(':','Session method: BiMail');
WAZOOMAX:=8192;
SetupTransferWindows(false);
ReqFile:=HoldFileName(Call,False)+'REQ';
IF IsCaller THEN
BEGIN
IF ExistFile(ReqFile) THEN
BEGIN
IF WzFReq IN RemHello.Capabilities THEN
BEGIN
ZModemSend(ReqFile,'',0,8192);
DeleteFile(ReqFile);
Inc(FSent);
END ELSE
AddLog(':','File Request declined');
END;
IF FSent=0 THEN ZModemSend('','',-2,8192) ELSE ZModemSend('','',-1,8192);
ZModemReceive(cfg.inbound[GlobNodeStat],True);
END ELSE
BEGIN
ZModemReceive(Cfg.Inbound[GlobNodeStat],True);
IF ExistFile(ReqFile) THEN
BEGIN
IF WzFReq IN RemHello.Capabilities THEN
BEGIN
ZModemSend(ReqFile,'',0,8192);
DeleteFile(ReqFile);
Inc(FSent);
END ELSE
AddLog(':','File Request declined');
END;
IF FSent=0 THEN ZModemSend('','',-2,8192) ELSE ZModemSend('','',-1,8192);
END;
RemoveTransferWindows;
DeleteFile(MakeTaskFileName('BIMODEM.PTH'));
DeleteFile(MakeTaskFileName(PoPBiModemInterComLog));
IF ((CurrentEvent.typ AND etNoSend) = 0) OR (Cfg.BiMail.NoSendOverride) THEN
SendWaZoo(0);
GetDir(0, SaveDir);
SaveDir:=AddBackSlash(SaveDir);
WriteBiModemConfig(Cfg.Modem.Commport, ComPort^.GetBaudRate, SaveDir);
IF ScreenHeight<=LinesForStat THEN IntroWin^.ScrollVert(-1);
MkDir('BIMAIL.!'+HexB(Cfg.TaskNumber)); InOutRes:=0;
ChangeDir('BIMAIL.!'+HexB(Cfg.TaskNumber));
IF IsCaller THEN
WHILE Not ComPort^.KeyPressed AND ComPort^.Carrier DO
GiveUpTime;
NormalCursor;
{ PoPGETMEM(SaveWin,20480);}
SaveWindow(1,1,ScreenWidth,ScreenHeight,True,SaveWin);
IF MaxAvail>102400 THEN
BEGIN
CASE ExecDos(Cfg.BiMail.BiModemPath+' /C'+MakeTaskFileName(SaveDir+PoPBimodemCfgFileName)+
' /'+MakeTaskFileName(SaveDir+PoPBiModemInterComLog),false,noexecdosproc) of
-1,
{ -4 : ShellToDos(Cfg.BiModemPath,' /CPORTAL.BMC /portal.icl',False);}
-2 : AddLog('!','Serious memory allocation error');
-3 : BEGIN
AddLog('!','Serious memory allocation error - Aborting');
Halt(254);
END;
END;
END ELSE
ShellToDos(Cfg.BiMail.BiModemPath,'/C'+MakeTaskFileName(SaveDir+PoPBimodemCfgFileName)+
' /'+MakeTaskFileName(SaveDir+PoPBiModemInterComLog),False);
RestoreWindow(1,1,ScreenWidth,ScreenHeight,True,SaveWin);
{ PoPFREEMEM(SaveWin,20480);}
HiddenCursor;
InOutRes:=0;
ChangeDir(SaveDir);
RmDir('BIMAIL.!'+HexB(Cfg.TaskNumber));
IF IOResult<>0 THEN AddLog('!', 'Can''t remove BiMail temp directory');
BiMailPostParse;
GOTO ItsOverAndOut;
END;
{$ENDIF}
{---------------------------------------------------------------------}
{ Here goes the code for Janus (When Wynn Wagner III has finished it) }
{---------------------------------------------------------------------}
IF DoesJanus IN SharedCap THEN
BEGIN
AddLog(':', 'Session method: Janus');
SetupTransferWindows(True);
DoJanus;
RemoveTransferWindows;
GOTO ItsOverAndOut;
END;
{---------------------------------------------------------------------}
{ This is the normal ZModem mail transfer. }
{---------------------------------------------------------------------}
IF (ZedZipper IN SharedCap) OR (ZedZapper IN SharedCap) THEN
BEGIN
IF ZedZapper IN SharedCap THEN
BEGIN
AddLog(':', 'Session method: ZedZap');
WAZOOMAX:=8192;
END ELSE
BEGIN
AddLog(':', 'Session method: ZedZip');
WAZOOMAX:=1024;
END;
IF ComPort^.Carrier THEN TransferNetFiles(1);
GOTO ItsOverAndOut;
END;
WaZoo:=False;
AddLog('!','No common session protocol');
ItsOverAndOut:
CloseReqFiles;
AddLog('*', 'End of mail session');
RemoveEmptyDir(Call);
i:=1;
WHILE (i<=MaxAddresses) AND (RemAkA[i].Zone<>0) DO
BEGIN
RemoveEmptyDir(RemAka[i]);
Inc(i);
END;
END;
FUNCTION Cooked(CONST s: STRING): STRING;
VAR
ss : STRING;
i : Byte;
Ch : S3;
BEGIN
ss:='';
FOR i:=1 TO Length(s) DO
BEGIN
Ch:=s[i];
IF (Ch='\') OR (Ch=']') OR (Ch='}') THEN
Ch:=Ch+Ch
ELSE
IF (Ch<#32) OR (Ch>#127) THEN Ch:='\'+HexB(Byte(s[i]));
ss:=ss+Ch;
END;
Cooked:=ss;
END;
FUNCTION UnCook(CONST s:STRING):STRING;
VAR
ss:STRING;
i:Byte;
ii,Test:Integer;
Ch:S3;
BEGIN
ss:='';
IF s<>'' THEN
BEGIN
i:=0;
REPEAT
INC(i);
IF s[i]='\' THEN
BEGIN
IF (i<LENGTH(s)) THEN
BEGIN
IF (s[i+1]='\') THEN
BEGIN
Ch:='\';
INC(i);
END ELSE
BEGIN
Val('$'+Copy(s,i+1,2),ii,Test);
Ch:=Char(ii);
INC(i,2);
END;
END ELSE
Ch:=s[i];
END ELSE
Ch:=s[i];
ss:=ss+Ch;
UNTIL i>=LENGTH(s);
END;
UnCook:=ss;
END;
FUNCTION NextWord(BufNum:Integer; VAR BufAdr; VAR i:Integer):STRING;
VAR
Buf : ARRAY[1..10240] OF Char Absolute BufAdr;
ss : STRING;
BEGIN
ss:='';
INC(i);
REPEAT
INC(i);
ss:=ss+Buf[i];
IF (Buf[i]='}') THEN
IF (i<BufNum) AND (Buf[i+1]='}') THEN
BEGIN
Inc(i);
Continue;
END;
UNTIL (i>=BufNum) OR (Buf[i]='}');
Dec(ss[0]);
NextWord:=Trim(UnCook(ss));
END;
FUNCTION NextWord2(VAR s: STRING): STRING;
VAR
ss:STRING;
Finished:BOOLEAN;
i : Integer;
BEGIN
ss:='';
i:=0;
Finished:=FALSE;
REPEAT
INC(i);
ss:=ss+s[i];
IF (s[i]=']') THEN
IF (s[i+1]<>']') THEN Finished:=True ELSE Inc(i);
UNTIL (i=Length(s)) OR Finished;
Delete(s,1,i);
Dec(ss[0]);
Delete(ss,1,1);
NextWord2:=Trim(ss);
END;
FUNCTION SendEMSIData: BOOLEAN;
LABEL
TryAgain,Out;
VAR
t1,t2 : EventTimer;
s,ss : STRING;
c,tries : Byte;
BufNum,i:Integer;
Crc16:Word;
Buf:^EMSIBUFType;
Flag:Boolean;
us : NodeListRecType;
BEGIN
SendEMSIData:=FALSE;
New(Buf);
IF Not CheckPassword(Not IsCaller) THEN GOTO Out;
s:='**EMSI_DAT';
Move(s[1],Buf^[1],10);
s:='{EMSI}{';
s:=s+Address2Str(Cfg.Addresses[AkaNum]);
FOR i:=1 TO MaxAddresses DO
BEGIN
IF (Cfg.Addresses[i].Zone<>0) AND (i<>AkaNum) THEN
s:=s+' '+Address2Str(Cfg.Addresses[i]);
END;
s:=s+'}{';
IF FoundInNodes AND (NodesRec.SessionPwd<>'') THEN s:=s+NodesRec.SessionPwd ELSE s:=s+NodeListEntry.Password;
IF IsCaller THEN
BEGIN
s:=s+'}{8N1,PUA}{';
{$IFNDEF OS2}
IF CanDoBimail In Hello.Capabilities THEN s:=s+'BIM,';
{$ENDIF}
IF DoesJanus In Hello.Capabilities THEN s:=s+'JAN,';
s:=s+'ZAP,ZMO,ARC,XMA';
END ELSE
BEGIN
s:=s+'}{8N1}{';
{$IFNDEF OS2}
IF (Cfg.BiMail.BimodemPath<>'') AND (CanDoBiMail IN RemHello.Capabilities) AND
(CanDoBiMail IN Hello.Capabilities) THEN s:=s+'BIM' ELSE
{$ENDIF}
IF (DoesJanus IN RemHello.Capabilities) And (DoesJanus IN Hello.Capabilities) THEN s:=s+'JAN' ELSE
IF ZedZapper IN RemHello.Capabilities THEN s:=s+'ZAP' ELSE
IF ZedZipper IN RemHello.Capabilities THEN s:=s+'ZMO' ELSE s:=s+'NCP';
IF NOT (WZFreq IN Hello.Capabilities) THEN s:=s+',HRQ';
END;
Move(s[1],Buf^[15],Length(s));
BufNum:=Length(s)+15;
s:='}{'+HexB(PoPProductCode)+'}{Portal of Power}{'+Cooked(Ver)+
'}{The best mailer, at the price of 5 postcards!}';
IF NOT FindNode(Cfg.Addresses[Cfg.MainAdrNum], us) THEN
BEGIN
us.MiscInfo:='-Unpublished-';
us.PhoneNumber:='-Unpublished-';
END;
s:=s+'{IDENT}{['+Cooked(cfg.system)+']['+Cooked(us.MiscInfo)+']['+
Cooked(Cfg.SysOp)+']['+us.phonenumber+']['+Long2Str(Cfg.Modem.BaudRate)+'][XA]}';
s:=s+'{TRX#}{['+HexL(NowAsUnixDate)+']}';
Move(s[1],Buf^[BufNum],Length(s));
Inc(BufNum, Integer(Length(s)-1));
s:=HexW(BufNum-14);
Move(s[1],Buf^[11],4);
Crc16:=0;
FOR i:=3 TO BufNum DO
Crc16:=UpdCRC16(Byte(Buf^[i]),Crc16);
Crc16:=UpdCRC16(0,Crc16);
Crc16:=UpdCRC16(0,Crc16);
Pause(50);
Tries:=0;
NewTimerSecs(t1, 60);
Flag:=FALSE;
REPEAT
ComPort^.PurgeIn;
ComPort^.PurgeOut;
TryAgain:
FOR i:=1 TO BufNum DO
ComPort^.WriteByte(Byte(Buf^[i]), False);
{!!! FPurgeIn;}
ComPort^.WriteStr(HexW(Crc16)+#13);
Inc(Tries);
IF Tries>6 THEN GOTO Out;
ss:='';
NewTimerSecs(t2, 20);
REPEAT
REPEAT
{ GiveUpTime;}
UNTIL ComPort^.KeyPressed OR (NOT ComPort^.Carrier) OR TimerExpired(t2) OR TimerExpired(t1);
IF NOT ComPort^.Carrier OR TimerExpired(t1) THEN GOTO Out;
IF TimerExpired(t2) THEN
BEGIN
AddLog('!','SendEMSI: Timeout') ;
GOTO TryAgain;
END;
IF ComPort^.KeyPressed THEN
BEGIN
c:=ComPort^.ReadByte;
IF c>=32 THEN
BEGIN
ss:=ss+Char(c);
IF Length(ss)>70 THEN Delete(ss,1,50);
Flag:=(Pos(EMSIACKStr,ss)>0);
END;
END;
UNTIL Flag OR (TimerExpired(t1));
UNTIL Flag;
SendEMSIData:=True;
Out:
Dispose(Buf);
END;
FUNCTION ReceiveEMSIData: Boolean;
LABEL
NoGood,TryAgain,GotRemains,Out;
VAR
AkAStr,s,ss,ns:STRING;
Tries:Byte;
Buf:^EMSIBufType;
crc16,pktcrc:WORD;
x,bufnum,test,i,c : Integer;
TestAddress: TFidoAddress;
N : TNodeInfo;
BEGIN
New(Buf);
ReceiveEMSIData:=False;
Tries:=4;
TryAgain:
Dec(Tries);
GotRemains:
IF Tries=0 THEN GOTO Out;
i:=14;
bufnum:=0;
REPEAT
IF NOT IsCaller THEN ComPort^.WriteStr(EMSIREQStr+#13);
c:=TimedRead(750);
IF NOT ComPort^.Carrier THEN GOTO Out;
IF c<0 THEN
BEGIN
NoGood:
ComPort^.PurgeIn;
ComPort^.WriteStr(EMSINAKStr+#13);
AddLog('!','GetEMSI: Drats');
GOTO TryAgain;
END;
IF (c>31) AND (c<128) THEN
BEGIN
Inc(BufNum);
buf^[bufnum]:=Char(c);
Dec(i);
END;
UNTIL (i=0);
Move(Buf^[1],s[1],14);
s[0]:=#14;
IF (s=EMSIINQStr) OR (s=EMSIACKStr) THEN GOTO GotRemains;
Move(buf^[11],s[1],4);
s[0]:=#4;
Val('$'+s,i,test);
test:=i;
INC(i,4);
REPEAT
c:=TimedRead(750);
IF NOT ComPort^.Carrier THEN GOTO Out;
IF c<0 THEN GOTO NoGood;
IF (c>31) AND (c<128) THEN
BEGIN
INC(BufNum);
Buf^[bufnum]:=Char(c);
Dec(i);
END;
UNTIL (i=0);
s[0]:=#4;
Move(buf^[bufnum-3],s[1],4);
Val('$'+s, pktcrc, i);
IF i<>0 THEN GOTO NoGood;
crc16:=0;
FOR i:=3 TO bufnum-4 DO
crc16:=UpdCRC16(Byte(buf^[i]), Crc16);
crc16:=UpdCRC16(0,Crc16);
crc16:=UpdCRC16(0,Crc16);
IF pktcrc<>crc16 THEN GOTO NoGood;
ComPort^.WriteStr(EMSIACKStr+EMSIACKStr+#13);
FillChar(RemHello, SizeOf(RemHello), 0);
i:=20;
Dec(BufNum, 4);
{ DECODE ACTUAL EMSI-DATA-PACKET AND CONVERT TO REMHELLO }
FillChar(RemHello,SizeOf(RemHello),0);
{ Adresses }
AkAStr:=NextWord(BufNum,Buf^,i)+' ';
{ Password }
ss:=NextWord(BufNum,Buf^,i);
IF Length(ss)>8 THEN ss[0]:=#8;
IF ss<>'' THEN Move(ss[1],RemHello.Password,Length(ss));
{ Decode Addresses - must be here so we have the password.... }
x:=0;
REPEAT
Inc(x);
ns:=Copy(AkAStr,1,POS(' ',AkAStr)-1);
Delete(AkAStr, 1, Length(ns)+1);
GetAdressFromStr(ns, TestAddress);
IF x=1 THEN
BEGIN
RemHello.Address:=TestAddress;
END ELSE
BEGIN
IF FindNodeInfo(N, TestAddress) And (N.SessionPwd<>'') And
(StUpCase(ss)<>StUpCase(N.SessionPwd)) THEN
BEGIN
AddLog('!', 'Password error on AKA ('+Address2Str(TestAddress)+'): (local/remote) '+
'"'+StUpCase(N.SessionPwd)+'"/"'+StUpCase(ss)+'"');
Dec(x);
END ELSE
RemAka[x-1]:=TestAddress;
END;
UNTIL (AkAStr='') OR (x>MaxAddresses);
{ PickUp Options }
EMSIData.Options:=NextWord(BufNum,Buf^,i);
{ Capabilities }
ss:=NextWord(BufNum,Buf^,i);
IF Pos('BIM',ss)<>0 THEN RemHello.Capabilities:=RemHello.Capabilities+[CanDoBiMail];
IF Pos('JAN',ss)<>0 THEN RemHello.Capabilities:=RemHello.Capabilities+[DoesJanus];
IF Pos('ZAP',ss)<>0 THEN RemHello.Capabilities:=RemHello.Capabilities+[ZedZapper];
IF Pos('ZMO',ss)<>0 THEN RemHello.Capabilities:=RemHello.Capabilities+[ZedZipper];
IF (Pos('NRQ',ss)= 0) AND (Pos('HRQ',ss)= 0) THEN RemHello.Capabilities:=RemHello.Capabilities+[WzFreq];
{ Product Code }
ss:=NextWord(BufNum,Buf^,i);
Val('$'+ss,RemHello.ProductCode,test);
{ Product Name }
EMSIData.ProdName:=NextWord(BufNum,Buf^,i);
{ Product version }
ss:=NextWord(BufNum,Buf^,i);
EMSIData.ProdName:=EMSIData.ProdName+'/'+ss;
ns:=Copy(ss,1,POS('.',ss)-1);
Delete(ss,1,Length(ns)+1);
Val(ns,RemHello.ProductMaj,test);
ns:='';
WHILE (Length(ss)>0) And (ss[1] IN ['0'..'9']) DO
BEGIN
ns:=ns+ss[1];
Delete(ss,1,1);
END;
Val(ns,RemHello.ProductMin,test);
{ Mail serial number }
EMSIData.ProdSerial:=NextWord(BufNum,Buf^,i);
{ Skip until IDENT }
REPEAT
ss:=NextWord(BufNum,Buf^,i);
UNTIL (ss='IDENT') Or (i>=BufNum);
IF ss='IDENT' THEN
BEGIN
{ System name }
ss:=NextWord(BufNum,Buf^,i);
ns:=NextWord2(ss);
IF Length(ns)>59 THEN ns[0]:=#59;
Move(ns[1],RemHello.SystemName,Length(ns));
EMSIData.Location:=NextWord2(ss);
ns:=NextWord2(ss); { SysOp }
IF Length(ns)>19 THEN ns[0]:=#19;
Move(ns[1],RemHello.SysOp,Length(ns));
EMSIData.Phone:=NextWord2(ss);
EMSIData.BaudRate:=NextWord2(ss);
EMSIData.Flags:=NextWord2(ss);
{ Skip until TRX# }
REPEAT
ss:=NextWord(BufNum,Buf^,i);
UNTIL (ss='TRX#') Or (i>=BufNum);
IF ss='TRX#' THEN
BEGIN
ss:=NextWord(BufNum,Buf^,i);
EMSIData.Tranx:=NextWord2(ss);
END;
END;
ShowHisData;
ReceiveEMSIData:=True;
Out:
Dispose(Buf);
END;
FUNCTION StartMailSession : Boolean;
LABEL
s1,s2,s4,s5,s6,s7,s8,s9,s10,EoS;
VAR
x : Integer;
t,
FailSafe : EventTimer;
Whacks,Ch: Byte;
InStr : String;
BEGIN
StartMailSession:=False;
Pause(150); { Wait for MNP garbage to stop }
ComPort^.PurgeIn; { Throw away any garbage in buffer }
ComPort^.PurgeOut;
fsent:=0;
Whacks:=0;
AkaNum:=0;
IsCaller:=True;
ExtFlags[1]:=' ';
RspFile:='';
InStr:='';
FillChar(EMSIData, SizeOf(EMSIData), 0);
FillChar(RemAka, SizeOf(RemAka), 0);
REPEAT
Pause(100);
ComPort^.WriteByte(32, False);
ComPort^.WriteByte(Cr, True); { Wakeup the mailer in other end }
IF ComPort^.KeyPressed THEN InStr:=ModemReadStr;
Inc(Whacks);
UNTIL (InStr<>'') OR (Whacks=15) OR (NOT ComPort^.Carrier);
IF Whacks = 15 THEN
BEGIN
AddLog(':', 'Other end is sleeping....');
Exit;
END;
IF NOT ComPort^.Carrier THEN
BEGIN
AddLog(':', 'Other end hung up on us!!');
Exit;
END;
MyWin(IntroWin,1, ScreenHeight-1, 80, ScreenHeight, 2,'',False);
IntroWin^.wFastText(' Intro: ' + InStr,1,1);
ComPort^.PurgeIn; ComPort^.PurgeOut;
s1:
NewTimerSecs(FailSafe, 30);
IF Cfg.UseEMSI THEN
BEGIN
IF NodesRec.UseEMSI='N' THEN GOTO s2;
END ELSE
BEGIN
IF NodesRec.UseEmsi<>'Y' THEN GOTO s2;
END;
IF Pos(EMSIREQStr, InStr)=0 THEN
BEGIN
Whacks:=2;
REPEAT
InStr:='';
ComPort^.WriteStr(EMSIINQStr+Char(YooHoo)+Char(TSync));
NewTimerSecs(t, 3);
REPEAT
IF ComPort^.KeyPressed THEN
BEGIN
Ch:=ComPort^.ReadByte;
IF (Ch=67) OR (Ch=NAK) THEN GOTO s4; { Indsat BK'95 }
IF (Ch>31) AND (Ch<128) THEN
BEGIN
InStr:=InStr+Char(Ch);
IF Copy(EMSIREQStr,1,Length(InStr))<>InStr THEN InStr:='';
END ELSE
IF (Ch=YooHoo) OR (Ch=TSync) THEN GOTO s4;
END;
UNTIL (TimerExpired(t)) OR (InStr=EMSIREQStr);
Dec(Whacks);
UNTIL (InStr=EMSIREQStr) OR (Whacks=0);
END ELSE
BEGIN
ComPort^.WriteStr(EMSIINQStr+#13);
InStr:=EMSIREQStr;
END;
IF InStr=EMSIREQStr THEN
BEGIN
FillOutHello;
IntroWin^.wFastText(' JoHo',2,1);
IF SendEMSIData THEN
BEGIN
IntroWin^.wFastText('/2U2',2,6);
IF ReceiveEMSIData THEN
BEGIN
StartMailSession:=WaZoo;
END;
END;
END ELSE
BEGIN
s2:
IF NOT ComPort^.Carrier THEN GOTO EoS;
ComPort^.WriteByte(YooHoo, False);
ComPort^.WriteByte(TSync, True);
s4:
x:=TimedRead(900); { Ændret fra 300 til 900 BK'95}
IF (x<0) OR NOT ComPort^.Carrier OR TimerExpired(FailSafe) THEN GOTO EoS;
CASE x OF
Enq : GOTO s8;
67 : GOTO s5;
Nak : GOTO s6;
01 : GOTO s7;
ELSE GOTO s4;
END;
s5:
x:=TimedRead(100); { Ændret fra 300 til 100 BK'95}
IF x<0 THEN
BEGIN
StartMailSession:=True;
FTSC_Sender(False);
GOTO EoS;
END;
IF TimerExpired(FailSafe) OR NOT ComPort^.Carrier THEN GOTO EoS;
CASE x OF
Enq : GOTO s8;
00,
01,
67 : BEGIN
StartMailSession:=True;
FTSC_Sender(False);
GOTO EoS;
END;
Nak : GOTO s6;
ELSE GOTO s4;
END;
s6:
x:=TimedRead(300);
IF (x<0) OR NOT ComPort^.Carrier OR TimerExpired(FailSafe) THEN GOTO EoS;
CASE x OF
Enq : GOTO s8;
67 : GOTO s5;
Nak : BEGIN
StartMailSession:=True;
FTSC_Sender(False);
GOTO EoS;
END;
01 : GOTO s7;
ELSE GOTO s4;
END;
s7:
x:=TimedRead(300);
IF (x<0) OR NOT ComPort^.Carrier OR TimerExpired(FailSafe) THEN GOTO EoS;
CASE x OF
Enq : GOTO s8;
67 : GOTO s5;
Nak : GOTO s6;
01 : GOTO s7;
$fe : BEGIN
StartMailSession:=True;
FTSC_Sender(False);
GOTO EoS;
END;
ELSE GOTO s4;
END;
s8:
IntroWin^.wFastText(' YooHoo',2,1);
IF SendHello THEN GOTO s9 ELSE GOTO s2;
s9:
IntroWin^.Select;
IntroWin^.wFastText('/2U2',2,8);
x:=TimedRead(500);
IF (x<0) OR NOT ComPort^.Carrier OR TimerExpired(FailSafe) THEN GOTO s2;
IF x=YooHoo THEN GOTO s10 ELSE GOTO s2;
s10:
IF GetHello THEN
BEGIN
StartMailSession:=WaZoo;
END ELSE
GOTO s2;
END;
EoS:
KillWindow(IntroWin);
END;
PROCEDURE ReceiveMailSession(InByte: Integer);
LABEL
v1,v2,v3,v4,v5,v6,EoS;
VAR
Errors : Byte;
BEGIN
IsCaller:=False;
ExtFlags[1]:='H';
RspFile:='';
FillChar(EMSIData, SizeOf(EMSIData), 0);
FillChar(RemAka,SizeOf(RemAka),0);
IF (InByte=0) AND Cfg.UseEMSI THEN
BEGIN
ComPort^.PurgeOut;
ComPort^.WriteStr(EMSIREQStr+#13);
IntroWin^.wFastText(' JoHo',2,1);
IF ReceiveEMSIData THEN
BEGIN
FillOutHello;
IntroWin^.wFastText('/2U2',2,6);
IF SendEMSIData THEN WaZoo ELSE AddLog('!','Failed EMSI Session');
END ELSE
AddLog('!','Failed EMSI Session');
END ELSE
BEGIN
Errors:=0;
v1:
IF InByte=YooHoo THEN GOTO v3;
v2:
FTSC_Receiver(False);
GOTO EoS;
v3:
IntroWin^.wFastText(' YooHoo',2,1);
IF GetHello THEN GOTO v4 ELSE
BEGIN
AddLog('!','Failed ZedZap Session');
GOTO EoS;
END;
v4:
InByte:=TimedRead(1000);
IF InByte<0 THEN GOTO v5;
IF InByte=Enq THEN GOTO v6 ELSE GOTO v4;
v5:
ComPort^.PurgeIn;
ComPort^.WriteByte(YooHoo, True);
INC(Errors);
IF Errors>4 THEN
BEGIN
AddLog('!','Mail session handshake failed');
GOTO EoS;
END;
GOTO v4;
v6:
IF SendHello THEN
BEGIN
IntroWin^.Select;
IntroWin^.wFastText('/2U2',2,8);
WaZoo;
GOTO EoS;
END ELSE
IF NOT ComPort^.Carrier THEN GOTO EoS;
GOTO v1;
END;
EoS:
KillWindow(IntroWin);
END;
END.